home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / library / parray.tcl < prev    next >
Text File  |  1993-02-06  |  2KB  |  44 lines
  1. # parray:
  2. # Print the contents of a global array on stdout.
  3. #
  4. # $Header: /user6/ouster/tcl/library/RCS/parray.tcl,v 1.5 93/02/06 16:33:45 ouster Exp $ SPRITE (Berkeley)
  5. #
  6. # Copyright (c) 1991-1993 The Regents of the University of California.
  7. # All rights reserved.
  8. #
  9. # Permission is hereby granted, without written agreement and without
  10. # license or royalty fees, to use, copy, modify, and distribute this
  11. # software and its documentation for any purpose, provided that the
  12. # above copyright notice and the following two paragraphs appear in
  13. # all copies of this software.
  14. #
  15. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  16. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  17. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  18. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  19. #
  20. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  21. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  22. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  23. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  24. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  25. #
  26.  
  27. proc parray a {
  28.     upvar 1 $a array
  29.     if [catch {array size array}] {
  30.     error "\"$a\" isn't an array"
  31.     }
  32.     set maxl 0
  33.     foreach name [lsort [array names array]] {
  34.     if {[string length $name] > $maxl} {
  35.         set maxl [string length $name]
  36.     }
  37.     }
  38.     set maxl [expr {$maxl + [string length $a] + 2}]
  39.     foreach name [lsort [array names array]] {
  40.     set nameString [format %s(%s) $a $name]
  41.     puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
  42.     }
  43. }
  44.